Almathera Ten Pack 3: CDPD 3/Almathera Ten on Ten - Disc 3: CDPD3.iso/scope/051-075/scopedisk69/jlib20a/demo

Text File | 1995-03-19 | 18KB | 512 lines

  ON BREAK GOSUB abort:BREAK ON
'  WINDOW 1,,(0,0)-(617,186),31,-1
  WINDOW 1,,(417,11)-(617,59),31,-1
  DEFINT a-z

'========== the jlib variable table - MUST NOT BE ALTERED!!!
  jlib&=0
  about&=0:w7&=0:bye&=0:getmem&=0:freemem&=0:zip&=0:copy&=0:anycmd&=0'jlib/exec
  at&=0:text&=0:printat&=0:shadow&=0:sxy&=0:scolr&=0            'graphics
  sbox&=0:dbox&=0:drawmode&=0:rgb&=0:blowup&=0
  title&=0:autoreq&=0:refresh&=0:setptr&=0:clrptr&=0:sgad&=0    'intuition
  exp1&=0:exp2&=0:exp3&=0:exp4&=0:exp5&=0:exp6&=0:exp7&=0:exp8&=0:exp9&=0
  bload&=0:bsave&=0:openDOS&=0:DOSfile&=0:closeDOS&=0           'dos
  checkfile&=0:request&=0:DOScmd&=0
  loadiff&=0:saveIFF&=0:load8svx&=0:play8svx&=0:kill8svx&=0     'iff/8svx
  loadfont&=0:usefont&=0:killfont&=0:style&=0                   'font

'========== these are highly recommended - but not required
  nl$=CHR$(0):nl3$=STRING$(3,0)

'========== load and set up the jlib file
  OPEN "jlib.ldr" FOR INPUT AS #1
     mlsize=LOF(1)/2-1:DIM ml(mlsize)
     FOR i=0 TO mlsize:ml(i)=CVI(INPUT$(2,1)):NEXT
  CLOSE #1
  ml&=VARPTR(ml(0)):ml& SADD("jlib2"+nl$),VARPTR(jlib&),WINDOW(7)  ':ERASE ml

'========== save a copy of original color table
  getmem& 64,65536&,0:orgRGB&=jlib&:rgb& 0,orgRGB&,0,32
  getmem& 64,65536&,0:cRGB&=jlib&      'temp storage for cycle SUB

'========== load fonts
  title& SADD("Loading fonts..."+nl$)
  loadfont& SADD("topaz"+nl$),8:topaz8&=jlib&
  loadfont& SADD("garnet"+nl$),16:garnet16&=jlib&

'========== set up jlib mouse pointer
  getmem& 80,65539&,0:ptr&=jlib&
  bload& SADD("jlib.p"+nl$),ptr&,80

'========== do title screen
  WINDOW CLOSE 1
  getmem& 640,65536&,0:newRGB&=jlib&
  bload& SADD("RGB"+nl$),newRGB&,640
  IF jlib&<>640 THEN PRINT jlib&:GOTO slowquit
  SCREEN 1,320,200,5,1
  WINDOW 2,,,16,1
  w7& WINDOW(7)
  setptr& ptr&,-1
  loadiff& SADD("jlib.pic"+nl$)
  GOSUB cyclepic
  rgb& 1,newRGB&+2*64,0,32

'========== demo ColorMaster and various rgb& functions/possibilities
  WINDOW 3,"jlib demo:  ",(10,40)-(301,150),0,1
  w7& WINDOW(7):setptr& ptr&,-1:scolr& 11,9:sxy& 1,1
  shadow& -1,5,SADD("You have just seen how jlib can"+nl$)
  shadow& -1,15,SADD("load an iff picture and some"+nl$)
  shadow& -1,25,SADD("color cycling possibilities."+nl$)
  shadow& -1,45,SADD("Now click the mouse to bring"+nl$)
  shadow& -1,55,SADD("up ColorMaster, which is a"+nl$)
  shadow& -1,65,SADD("palette requester subroutine."+nl$)
  shadow& -1,85,SADD("ColorMaster demonstrates several"+nl$)
  shadow& -1,95,SADD("more of the rgb& functions."+nl$)
  CALL whoa
  WINDOW CLOSE 3:w7& WINDOW(7)
  scrn=1:GOSUB cmaster

'========== MoveScreen& with anycmd&
  scrn&=PEEKL(WINDOW(7)+46)
'                 offset -162 in intuition.library (a6=1) is MoveScreen&
  FOR i=0 TO 210:anycmd& -162,0,1,2,3,4,5,6,7,scrn&,1,2,3,4,5,1:NEXT
  WINDOW 3,"jlib demo:  ",(50,22)-(581,170),0,-1
  w7& WINDOW(7):setptr& ptr&,-1:scolr& 1,2:sxy& 5,2
  POKE WINDOW(7)+98,3:POKE WINDOW(7)+99,2:refresh&
  shadow& -1,5,SADD("The title screen was slid down by using `anycmd& to call the'"+nl$)
  shadow& -1,15,SADD("Intuition function `MoveScreen'.  `anycmd&' can be used to call"+nl$)
  shadow& -1,25,SADD("any library function not directly supported by a jlib command..."+nl$)
  shadow& -1,35,SADD("and still without the need of a BMAP!"+nl$)
  shadow& -1,50,SADD("Now I will demonstrate a new jlib function called blowup&."+nl$)
  shadow& -1,60,SADD("This function will `blowup', or enlarge a section of the display"+nl$)
  shadow& -1,70,SADD("and could be useful for such things as editor screens, etc."+nl$)
  shadow& -1,85,SADD("During this part of the demo you will be able to click in the"+nl$)
  shadow& -1,95,SADD("title screen window and the area around where you click"+nl$)
  shadow& -1,105,SADD("will be blown up into the smaller window."+nl$)
  shadow& -1,120,SADD("To continue from there, click in that smaller window."+nl$)
  shadow& -1,135,SADD("CLICK MOUSE TO CONTINUE"+nl$):whoa
  WINDOW CLOSE 3
  anycmd& -336,0,1,2,3,4,5,6,7,0,1,2,3,4,5,1  'WBenchToBack&
  FOR i=0 TO 210:anycmd& -162,0,-1,2,3,4,5,6,7,scrn&,1,2,3,4,5,1:NEXT

'========== demo blowup& function
  rp1&=WINDOW(8)
  WINDOW 3,"",(211,0)-(311,100),2,1
  w7& WINDOW(7)
  rgb& 1,newRGB&+2*64,0,32
bloop:
  whoa
  x=MOUSE(3)-10
  y=MOUSE(4)-10
  blowup& rp1&,x,y,20,20,WINDOW(8),0,0,5,3
  IF WINDOW(0)<>3 THEN bloop
  WINDOW CLOSE 3

'========== rainbow text demo
rbow:
  CLS
  w7& WINDOW(7)
  rgb& 1,orgRGB&,0,32

'here's another way to do a color table!
  DIM rbows(7):FOR i=0 TO 7:READ msg$:rbows(i)=VAL("&h"+msg$):NEXT
  rgb& 1,VARPTR(rbows(0)),0,8
  DATA 000,aaa,f00,f80,ff0,0f0,00f,f0f

  x=-1:y=65:rainbow 0,x,y,"Rainbow Text!":i=x/2:temp=x/5
  blowup& WINDOW(8),x,y,104,8,WINDOW(8),temp,5,5,3
  blowup& WINDOW(8),x,y,104,8,WINDOW(8),i,45,2,0
  rainbow 1,-1,75,"(not a jlib function)"
  rainbow 2,-1,85,"(just a neat trick!)"

  usefont& garnet16&
  x=-1:y=100:rainbow 3,x,y,"Rainbow Text!"
  blowup& WINDOW(8),x-17,y-1,156,18,WINDOW(8),0,120,2,0

  usefont& topaz8&
'  rainbow 4,-1,165,"Poke the rodent in the eye!"
  rainbow 4,-1,175,"(click the mouse button)"

  WHILE MOUSE(0)<>0:WEND
  WHILE MOUSE(0)=0:cycle 2,6:WEND
  scrn&=PEEKL(WINDOW(7)+46)
  FOR i=0 TO 26
    anycmd& -162,0,8,2,3,4,5,6,7,scrn&,1,2,3,4,5,1
    cycle 2,6
  NEXT
  WINDOW CLOSE 2
  SCREEN CLOSE 1

'========== about&
  WINDOW 2,"jlib demo:",(0,0)-(631,186),16,-1
  w7& WINDOW(7):POKE WINDOW(7)+99,3:refresh&
  setptr& ptr&,-1
  about&

'========== text demo
  title& SADD("Here are some text commands..."+nl$)
  CLS
  usefont& garnet16&
  COLOR 1
  at& 0,20:text& SADD("`at&' and `text&' position and print text."+nl$)
  printat& 0,26,SADD("However, since both will almost always be used together,"+nl$)
  printat& 0,42,SADD("`printat&' might be a better choice, as it combines the two."+nl$)
  printat& -1,58,SADD("Also, both `printat&' and `shadow&' offer automatic text centering"+nl$)
  printat& -1,74,SADD("if the x coordinate is equal to -1,"+nl$)
  printat& -2,90,SADD("or right-justification"+nl$)
  printat& -2,106,SADD("if the x coordinate is equal to -2,"+nl$)
  printat& -1,122,SADD("They also compensate for the font's baseline,"+nl$)
  printat& -1,138,SADD("so that the x,y coordinates always define the upper left corner."+nl$)
  COLOR 3:sbox& -1,160,SADD("Click Mouse"+nl$):whoa

'========== shadow text
  CLS
  title& SADD("More text commands..."+nl$)
  shadow& -1,0,SADD("Which brings us to `shadow&'!"+nl$)
  shadow& -1,20,SADD("(Doesn't it dress up a display?)"+nl$)
  shadow& 20,45,SADD("Shadow"+nl$)
  scolr& 3,2:shadow& 96,45,SADD("foreground"+nl$)
  scolr& 1,2:shadow& 200,45,SADD("and"+nl$)
  scolr& 1,3:shadow& 240,45,SADD("background"+nl$)
  scolr& 1,2:shadow& 350,45,SADD("may be changed with `scolr&'."+nl$)
  shadow& -1,65,SADD("`scolr&' is independant of BASIC's colors"+nl$)
  shadow& -1,80,SADD("and returns you to them after shadow printing."+nl$)
  scolr& 1,2:sxy& -5,-2:COLOR 2
  shadow& -1,100,SADD("(The shadow's position may also be adjusted with `sxy&'.)"+nl$)
  usefont& topaz8&:scolr& 1,2:sxy& 5,2
  shadow& -1,125,SADD("The text's style may also be changed!"+nl$)
  style& 1:shadow& 128,135,SADD("Underlined,"+nl$)
  style& 2:shadow& 224,135,SADD("bold,"+nl$)
  style& 4:shadow& 272,135,SADD("italics,"+nl$)
  style& 7:shadow& 344,135,SADD("or any combination"+nl$)
  style& 0:shadow& -1,145,SADD("of text may be selected using `style&'."+nl$)
  usefont& garnet16&
  COLOR 3,1:dbox& -1,160,SADD("Click Mouse!"+nl$):whoa

'========== drawmode and gadgety things
  title& SADD("Drawmode can be changed with `drawmode&'..."+nl$)
  drawmode& 2:FOR i=0 TO 186:LINE (0,186-i)-(630,186-i):NEXT:pause 2!
  title& SADD("Boxes..."+nl$)
  drawmode& 1:FOR i=0 TO 186:LINE (0,i)-(630,i),2:NEXT
  scolr& 1,0
  shadow& -1,5,SADD("There are also two types of boxes"+nl$)
  shadow& -1,25,SADD("that may be drawn around your text."+nl$)
  usefont& topaz8&
  scolr& 1,2
  COLOR 3,0:sbox& 20,49,SADD("This is sbox&"+nl$)
  COLOR 0,1:dbox& 481,49,SADD("This is dbox&"+nl$)
  usefont& garnet16&
  COLOR 3,0:sbox& 20,68,SADD("This is sbox&"+nl$)
  COLOR 0,1:dbox& 467,68,SADD("This is dbox&"+nl$)
  scolr& 3,0
  shadow& -1,47,SADD("The boxes are automatically"+nl$)
  shadow& -1,62,SADD("sized around whatever"+nl$)
  shadow& -1,77,SADD("font is being used."+nl$)
  shadow& -1,92,SADD("The x,y coordinates point to the top left corner of the box."+nl$)
  scolr& 1,0
  COLOR 3,0:sbox& -1,116,SADD("Let's get some letters with descenders"+nl$)
  COLOR 0,1:dbox& -1,140,SADD("so you can see why there was extra space in those boxes!"+nl$)
  scolr& 1,3:shadow& -1,164,SADD("Click Mouse!"+nl$):whoa

'========== ARP requester
  COLOR 1,0:CLS
  POKE WINDOW(7)+98,3
  POKE WINDOW(7)+99,2
  refresh&
  title& SADD("Testing the ARP File Requester..."+nl$)
  sxy& 2,1:scolr& 1,2
  shadow& -1,5,SADD("Select any file..."+nl$)
  shadow& -1,20,SADD("(Try pressing right mouse button, too!)"+nl$)
  file$="df0:"+STRING$(350,0)
  request& 20,50,SADD("ARP Requester - first color"+nl$),SADD(file$),0
  file$=LEFT$(file$,INSTR(file$,CHR$(0))-1)
  IF file$="" THEN file$="No file selected!"
  shadow& 0,40,SADD(file$+nl$)
  file$="df0:"+STRING$(350,0)
  request& 300,50,SADD("ARP Requester - second color"+nl$),SADD(file$),1
  file$=LEFT$(file$,INSTR(file$,CHR$(0))-1)
  IF file$="" THEN file$="No file selected!"
  shadow& 0,55,SADD(file$+nl$)
  pause 3!

'========== autorequesters, string gadgets
  CLS
  usefont& topaz8&
  POKE WINDOW(7)+99,1:refresh&
  drawmode& 0:sxy& 5,2:scolr& 1,2
  title& SADD("Autorequesters!"+nl$)
       msg$="This is how you build"+nl$
  msg$=msg$+"an AutoRequester (you"+nl$
  msg$=msg$+"need to be looking at"+nl$
  msg$=msg$+"the source to see it,"+nl$
  msg$=msg$+"of course!)"+nl3$          'notice nl3$ at end
  autoreq& SADD(msg$),SADD("LEFT"+nl$),SADD("RIGHT"+nl$)
  shadow& 300,0,SADD("You pressed "+MID$("RIGHTLEFT",5*jlib&+1,5)+nl$)
  autoreq& SADD("Please press another button!"+nl3$),SADD("LEFT"+nl$),SADD("RIGHT"+nl$)
  shadow& 444,0,SADD("- You pressed "+MID$("RIGHTLEFT",5*jlib&+1,5)+nl$)
  title& SADD("String Gadgets, too!"+nl$)
  shadow& 0,15,SADD("Enter your name:"+nl$)
  COLOR 3:dbox& 150,11,SADD(SPACE$(20)+nl$)
  msg$="john everett"+STRING$(41,0)  'theres xtra space here
  sgad& 158,15,160,8,41,0,SADD(msg$)
  msg$=LEFT$(msg$,INSTR(msg$,nl$)) 'nl$)-1) if you don't want NULL terminator
  shadow& 0,30,SADD("You typed: "+msg$)
  shadow& -1,40,SADD("I've left the drawing of a border around the gadget"+nl$)
  shadow& -1,50,SADD("to you, so that you can custom-design your screens easier."+nl$)
  shadow& -1,60,SADD("For instance, if you wanted an iff pic for a data entry screen,"+nl$)
  shadow& -1,70,SADD("a border might destroy part of your picture."+nl$)
  shadow& -1,80,SADD("You could use a LINE command or dbox& if you just needed a simpler border."+nl$)
  shadow& -1,95,SADD("Integer gadgets are also supported for numeric entry."+nl$)
  shadow& 0,110,SADD("Enter a number:"+nl$)
  LINE (129,109)-STEP(81,9),3,b
  msg$=STRING$(11,0)
  sgad& 130,110,80,8,11,5,SADD(msg$)
  msg$=LEFT$(msg$,INSTR(msg$,nl$))
  shadow& 220,110,SADD("You entered: "+msg$)  'integer gadgets also return their value in jlib&
  shadow& -1,125,SADD("Left, center, and right-justification"+nl$)
  shadow& -1,135,SADD("inside the gadget are also supported."+nl$)
  shadow& 0,150,SADD("Enter anything:"+nl$)
  LINE (129,149)-STEP(161,9),3,b
  msg$="anything"+STRING$(21,0)
  sgad& 130,150,160,8,21,2,SADD(msg$)
  msg$=LEFT$(msg$,INSTR(msg$,nl$))
  shadow& 320,150,SADD("You entered: "+msg$)
  shadow& -1,170,SADD("Click Mouse!"+nl$):whoa

'========== DOScmd&
  CLS
  title& SADD("More jlib demo..."+nl$)
  shadow& 0,10,SADD("Testing DOScmd& `dir > ram:temp'..."+nl$)
  DOScmd& SADD("dir > ram:temp"+nl$)
  OPEN "ram:temp" FOR INPUT AS #1
    i=20
    WHILE NOT EOF(1)
      LINE INPUT #1,msg$
      shadow& 0,i,SADD(msg$+nl$)
      i=i+10
    WEND
  CLOSE 1:KILL "ram:temp"
  shadow& 0,i+10,SADD("CLICK MOUSE"+nl$):whoa

'======== finish
  WINDOW CLOSE 2
  SCREEN 1,320,200,5,1
  WINDOW 3,"CLICK MOUSE IN WINDOW...",(30,40)-(291,120),0,1
  w7& WINDOW(7)
  shadow& -1, 5,SADD("Well, that's about it!"+nl$)
  shadow& -1,15,SADD("Experiment and have fun!"+nl$)
  shadow& -1,25,SADD("I'll send you back to the title"+nl$)
  shadow& -1,35,SADD("screen and you can play with"+nl$)
  shadow& -1,45,SADD("colors using the numeric"+nl$)
  shadow& -1,55,SADD("keypad, or you can press the"+nl$)
  shadow& -1,65,SADD("ESCape key to quit."+nl$)
  GOSUB cyclemouse
  WINDOW CLOSE 3
  WINDOW 4,,,16,1
  w7& WINDOW(7)
  setptr& ptr&,-1
  loadiff& SADD("jlib.pic"+nl$)
  colr=2
eloop:
  GOSUB cyclepic
  IF key$="" THEN key$=MID$("PDWROYGBV",INT(9*RND)+1,1)
  IF key$=CHR$(27) THEN quit
  IF VAL(key$)>0 THEN colr=VAL(key$) ELSE colr=INSTR("PDWROYGBV",key$)
  IF key$="P" THEN colr=9
  GOTO eloop

cyclepic:
  IF colr>1 THEN
    copy& newRGB&+colr*64,newRGB&,32,2
    copy& newRGB&+colr*64,newRGB&+64,32,2
  END IF
  IF MOUSE(0)<>0 THEN WHILE MOUSE(0)<>0:WEND
  key$="":showtime!=TIMER+10
  WHILE MOUSE(0)=0 AND key$="" AND TIMER<showtime!
    rgb& 1,newRGB&,0,32
    IF colr<2 THEN
      copy& newRGB&+3*64+2*count,newRGB&,32,2
      count=count+1:IF count MOD 32=0 THEN count=32*INT(6*RND)
    ELSE
      temp=PEEKW(newRGB&)
      copy& newRGB&+2,newRGB&,31,2
      POKEW newRGB&+62,temp
    END IF
    key$=UCASE$(INKEY$)
  WEND
  RETURN

'========== cycle mouse pointer
cyclemouse:
  setptr& ptr&,-1
  rgb& 1,ptr&+74,17,3        'if you want to load the .p file's colors
  getmem& 12,65537&,1:p&=jlib&
  rgb& 0,p&,17,3:copy& p&,p&+6,3,2
  pause 1!:i=MOUSE(0)
  WHILE MOUSE(0)=0
    temp=PEEKW(p&):copy& p&+2,p&,2,2:POKEW p&+4,temp
    rgb& 1,p&,17,3:pause .1
  WEND
  rgb& 1,p&+6,17,3
  freemem& p&
  RETURN

'========== ColorMaster subroutine
cmaster:
  IF scrn=0 THEN scrn=-1
  WINDOW 8,"Color Master ",(100,40)-(237,132),18,scrn
  w7& WINDOW(7)
'========== if this is the first time through, then set up color tables
  IF undoRGB&=0 THEN
    getmem& 64,65537&,0:undoRGB&=jlib& 'for undo function
    DIM colr(2)
  END IF
'========== set up undo buffer and draw requester
  rgb& 0,undoRGB&,0,32
  FOR y=0 TO 3
    FOR x=0 TO 7
      z=(8*y+x) AND WINDOW(6) 'eliminates illegal color values
      IF 8*y+x=colr THEN LINE (17*x+1,10*y+39)-STEP(17,10),WINDOW(6)-colr-(colr=WINDOW(6)),bf
      LINE (17*x+3,10*y+40)-STEP(13,8),z,bf
    NEXT
  NEXT
  COLOR 3,0
  sbox& 0,81,SADD("reset"+nl$)
  sbox& 53,81,SADD("undo"+nl$)
  sbox& 98,81,SADD(" ok "+nl$)
  rgb& 2,VARPTR(colr(0)),colr,1
  FOR z=0 TO 2:GOSUB slider:NEXT
'========== the requester loop
cloop:
  whoa
  IF WINDOW(0)<>8 THEN cloop
  IF MOUSE(4)<39 THEN
    z=INT(MOUSE(4)/13)
    WHILE MOUSE(0)<0
      colr(z)=(MOUSE(1)-18)/8
      IF colr(z)<0 THEN colr(z)=0
      IF colr(z)>15 THEN colr(z)=15
      rgb& 3,VARPTR(colr(0)),colr,1
      GOSUB slider
    WEND
  ELSEIF MOUSE(4)>80 THEN
    IF MOUSE(3)<50 THEN            'reset
      rgb& 1,orgRGB&,0,32
      rgb& 2,VARPTR(colr(0)),colr,1
      FOR z=0 TO 2:GOSUB slider:NEXT
    ELSEIF MOUSE(3)>95 THEN        'ok
      WINDOW CLOSE 8
      w7& WINDOW(7)
      RETURN
    ELSE                           'undo
      rgb& 1,undoRGB&,0,32
      rgb& 2,VARPTR(colr(0)),colr,1
      FOR z=0 TO 2:GOSUB slider:NEXT
    END IF
  ELSE
    y=INT(colr/8):x=colr-8*y
    LINE (17*x+1,10*y+39)-STEP(17,10),0,bf
    LINE (17*x+3,10*y+40)-STEP(13,8),colr,bf
    x=INT((MOUSE(3)-1)/17):y=INT((MOUSE(4)-40)/10)
    colr=(8*y+x) AND WINDOW(6)
    y=INT(colr/8):x=colr-8*y:IF colr=WINDOW(6) THEN z=1 ELSE z=WINDOW(6)-colr
    LINE (17*x+1,10*y+39)-STEP(17,10),z,bf
    LINE (17*x+3,10*y+40)-STEP(13,8),colr,bf
    rgb& 2,VARPTR(colr(0)),colr,1
    FOR z=0 TO 2:GOSUB slider:NEXT
  END IF
  GOTO cloop
slider:
  sbox& 0,13*z,SADD(HEX$(colr(z))+nl$)
  LINE (8*colr(z)+19,13*z)-(138,13*z+11),0,bf
  LINE (18,13*z)-STEP(8*colr(z),11),3,bf
  RETURN

slowquit:
  BEEP:whoa
'  autoreq& SADD("SLOWQUIT"+nl3$),SADD("OK"+nl$),SADD("OK"+nl$)
quit:
  WINDOW CLOSE 2
  SCREEN CLOSE 1
  WINDOW 1,"Bye!",(417,11)-(617,59),31,-1
  IF bye&>0 THEN
    w7& WINDOW(7)
    killfont& topaz8&
    killfont& garnet16&
    rgb& 1,orgRGB&,0,32   'replace original colors
    bye&
  END IF
  END
abort:RETURN quit

SUB whoa STATIC
  SHARED bye&
  WHILE MOUSE(0)<>0:WEND
  WHILE MOUSE(0)=0:SLEEP:WEND
END SUB

SUB pause(delay!) STATIC
  delay!=delay!+TIMER
  WHILE MOUSE(0)<>0:WEND
  WHILE TIMER<delay! AND MOUSE(0)=0:WEND
END SUB

SUB rainbow(style,x,y,text$) STATIC
  SHARED anycmd&,drawmode&,printat&,blowup&,nl$,ml(),bye&
  length=8*LEN(text$)
  IF x=-1 THEN x=(WINDOW(2)-length)/2
  COLOR 0,1
  drawmode& 1
  ON style+1 GOTO z0,z1,z2,z3,z4
z0:
  LINE (x,y)-STEP(length-1,0),2
  FOR i=2 TO 7:LINE (x,i+y-1)-STEP(length-1,0),i:NEXT
  LINE (x,y+7)-STEP(length-1,0),7
  GOTO endit
z1:
  FOR i=2 TO 7:LINE (x+i-2,y)-STEP(0,7),i:NEXT
  GET(x,y)-(x+7,y+7),ml
  FOR i=0 TO length/6-1:PUT(x+6*i,y),ml,PSET:NEXT
  GOTO endit
z2:
  LINE (x,y)-(x+7,y+7),2,bf
  FOR i=0 TO 5
    LINE (x,y+7-i)-(x+7-i,y),7-i
    LINE (x+i,y+7)-(x+7,y+i),7-i
  NEXT
  GOTO finish
z3:
  length=2*length-1:x=96
  LINE (0,y-1)-(15,y+16),2,bf
  FOR i=0 TO 4
    CIRCLE (7,y+7),2*(4-i),i+3
    PAINT (7,y+7),i+3,i+3
  NEXT
  GET(0,y-1)-(15,y+16),ml
  FOR i=0 TO 19:PUT(16*i,y-1),ml,PSET:NEXT
  LINE (x-1,y)-STEP(0,15),0
  GOTO endit
z4:
  LINE (x,y)-(x+7,y+7),2,bf
  FOR i=0 TO 4
    LINE (x+i,y)-(x+7-i,y+7),i+3
    LINE (x,y+i)-(x+7,y+7-i),i+3
  NEXT
finish:
  GET(x,y)-(x+7,y+7),ml
  FOR i=0 TO length/8-1:PUT(x+8*i,y),ml,PSET:NEXT
endit:
  drawmode& 4
  printat& x,y,SADD(text$+nl$)
  drawmode& 1
END SUB

SUB cycle(start,num) STATIC
  SHARED cRGB&,rgb&,copy&
  rgb& 0,cRGB&,start,num
  temp=PEEKW(cRGB&)
  copy& cRGB&+2,cRGB&,num,2
  POKEW cRGB&+2*num-2,temp
  rgb& 1,cRGB&,start,num
END SUB